﻿<%
'验证码类
Class CaptchaClass
	
	Private s_textDataLib, s_textData, s_bmpData, s_bmpHead, s_bmpWidth, s_bmpHeight, s_bmpSize, s_textDataLength,s_sessionString
	'验证码Session\字符个数\底色\字体颜色\噪点颜色\噪点比例0-100\字符宽\字符长
	Public SessionName,TextLength,BackColor,TextColor,YawpColor,YawpCount,CharWidth,CharHeight
	
	'''构造
	Private Sub Class_Initialize()
		SessionName = "CheckCode"
		CharWidth = 12
		CharHeight = 18
		TextLength = 4
		BackColor = "#FFFFFF"
		TextColor = "#FF0000,#333333,#009900,#0000FF,#9900CC,#FF9900,#339999"
		YawpColor = "#FF9900,#99CC00,#EEEEEE,#FFFF00,#FF0000,#009900,#66FFFF"
		YawpCount = 10
		ReDim s_textDataLib(0)
		s_textDataLib(0) = ""
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
	End Sub

	'''设置验证码额外信息
	'p_s:要附加的信息
	Public Function SetTextInfo(Byval p_s)
		ReDim s_textDataLib(0)
		s_textDataLib(0) = p_s
	End Function

	'''往字符集添加字符
	'p_s:规定格式的字符串
	Public Function AddTextData(Byval p_s)
		s_textDataLength = UBound(s_textDataLib) + 1
		ReDim Preserve s_textDataLib(s_textDataLength)
		s_textDataLib(s_textDataLength) = p_s
	End Function
	
	'''添加数字字符
	Private Sub addDefNumText_()
		'AddTextData "0 11100001 11110111 10111101 11101111 01111011 11011110 11110111 10111101 11101111 01111011 11011110 11111000 01110000"
		AddTextData "1 00000000 00000000 00110000 01010000 00011000 00011000 00011000 00011000 00011000 00011000 01111100 00000000 00000000"
		AddTextData "2 00111100 01111110 11100111 11000011 00000011 00000011 00000110 00001100 00011000 00110000 01100000 11111111 11111111"
		AddTextData "3 00111000 01111110 11000110 00000110 00000110 00011100 00011110 00000011 00000011 11000011 11000011 01111110 00111100"
		AddTextData "4 000001100 000011100 000011100 000111100 001101100 001101100 011001100 110001100 111111111 111111111 000001100 000001100 000001100"
		AddTextData "5 01111110 01111110 01100000 11000000 11011100 11111110 11000011 00000011 00000011 11000011 11000011 01111110 00111100"
		AddTextData "6 00111100 01111110 01100011 11000000 11000000 11011100 11111110 11100011 11000011 11000011 01100011 01111110 00111100"
		AddTextData "7 11111111 11111111 00000010 00000110 00001100 00001100 00011000 00011000 00011000 00011000 00110000 00110000 00110000"
		AddTextData "8 00111100 01111110 11000011 11000011 11000011 01111110 01111110 11000011 11000011 11000011 11000011 01111110 00111100"
		'AddTextData "9 00000000 00000000 00111000 01000100 01000100 01001100 00110100 00000100 00000100 01111000 00000000 00000000"
	End Sub
	
	'''添加字母字符
	Private Sub addDefEngText_()
		AddTextData "A 0011110000 0000110000 0001111000 0001111000 0011001100 0011001100 0011111100 0110000110 0110000110 1111001111"
		AddTextData "b 11000000 11000000 11000000 11011100 11111110 11100111 11000011 11000011 11000011 11000011 11100111 11111110 11011100"
		AddTextData "B 11111110 01100011 01100011 01100011 01111110 01100011 01100011 01100011 01100011 11111110"
		AddTextData "c 0011110 0111111 1110011 1100000 1100000 1100000 1100000 1110011 0111111 0011110"
		AddTextData "C 00111111 01100111 11000011 11000011 11000000 11000000 11000000 11000000 01100011 00111110"
		AddTextData "d 00000011 00000011 00000011 00111011 01111111 11100111 11000011 11000011 11000011 11000011 11100111 01111111 00111011"
		AddTextData "e 00111100 01111110 11100110 11000011 11111111 11111111 11000000 11100011 01111110 00111100"
		AddTextData "E 11111111 01100011 01100000 01101100 01111100 01101100 01100000 01100000 01100011 11111111"
		'AddTextData "f 0001111 0011111 0011000 0011000 0011000 1111110 1111110 0011000 0011000 0011000 0011000 0011000 0011000 0011000 0111000"
		AddTextData "F 11111111 01100011 01100000 01101100 01111100 01101100 01100000 01100000 01100000 01100000"
		AddTextData "G 001111110 011001110 110000110 110000110 110000000 110011111 110000110 110000110 011000110 001111100"
		AddTextData "h 11000000 11000000 11000000 11011110 11111111 11100011 11000011 11000011 11000011 11000011 11000011 11000011 11000011"
		AddTextData "H 1111001111 0110000110 0110000110 0110000110 0111111110 0110000110 0110000110 0110000110 0110000110 1111001111"
		AddTextData "J 000111111 000001100 000001100 000001100 000001100 000001100 000001100 110001100 110001100 011111000"
		AddTextData "k 11000000 11000000 11000000 11000111 11001110 11011100 11110000 11111000 11011000 11001100 11001100 11000110 11000111"
		AddTextData "K 111111110 011001100 011011000 011011000 011110000 011110000 011011000 011001100 011000110 111100111"
		AddTextData "L 11111000 01100000 01100000 01100000 01100000 01100000 01100000 01100000 01100011 11111111"
		AddTextData "m 110111001110 111111011111 111001110011 110001100011 110001100011 110001100011 110001100011 110001100011 110001100011 110001100011"
		AddTextData "M 1110000111 0110000110 0111001110 0111001110 0111111110 0111111110 0110110110 0110110110 0110000110 1111001111"
		AddTextData "n 11011110 11111111 11100011 11000011 11000011 11000011 11000011 11000011 11000011 11000011"
		AddTextData "N 1110011111 0110000110 0111000110 0111100110 0111100110 0110110110 0110011110 0110011110 0110001110 1111100110"
		AddTextData "p 11011100 11111110 11100111 11000011 11000011 11000011 11000011 11100111 11111110 11011100 11000000 11000000 11000000 11000000"
		AddTextData "P 11111110 01100011 01100011 01100011 01100011 01111110 01100000 01100000 01100000 01100000"
		AddTextData "R 111111100 011000110 011000110 011000110 011000110 011111100 011011000 011001100 011000110 111100111"
		AddTextData "s 01111110 11111110 11000000 11100000 01111100 00011110 00000011 10000011 11111111 01111100"
		AddTextData "S 01111111 11000111 11000011 11000000 01111000 00001110 00000011 11000011 11100011 11111110"
		AddTextData "t 00110000 00110000 11111111 11111111 00110000 00110000 00110000 00110000 00110000 00110000 00111111 00011111"
		AddTextData "T 11111111 10011001 00011000 00011000 00011000 00011000 00011000 00011000 00011000 00011000"
		AddTextData "u 11000011 11000011 11000011 11000011 11000011 11000011 11000011 11000111 11111111 01111011"
		AddTextData "U 1111001111 0110000110 0110000110 0110000110 0110000110 0110000110 0110000110 0110000110 0111001110 0001111000"
		AddTextData "v 110000011 011000011 011000110 011000110 001100110 001100100 000110100 000111100 000111000 000011000"
		AddTextData "V 1111001111 0110000110 0110000110 0011001100 0011001100 0011001100 0001111000 0001111000 0000110000 0000110000"
		AddTextData "w 11000000001 11000110011 11001110011 01001010010 01001010010 01101011010 01110011110 01110001110 00110001100 00110001100"
		AddTextData "W 1110000111 1100000011 1100110011 1100110011 0111111110 0111111110 0111111110 0011001100 0011001100 0011001100"
		AddTextData "x 111000011 011000110 001101100 001111100 000111000 000111000 001111100 001001100 011000110 110000111"
		AddTextData "X 1111001111 0110000110 0011001100 0001111000 0000110000 0000110000 0001111000 0011001100 0110000110 1111001111"
		AddTextData "y 1100000011 0110000010 0110000110 0011000100 0011001100 0001101000 0001111000 0001111000 0000110000 0000110000 0001100000 0111100000 0111000000"
		AddTextData "Y 1111001111 0110000110 0011001100 0011001100 0001111000 0000110000 0000110000 0000110000 0000110000 0000110000"
		AddTextData "z 11111111 11111111 00000011 00000110 00001100 00011000 00110000 01100000 11111111 11111111"
		AddTextData "Z 11111111 11000011 00000110 00001100 00011000 00011000 00110000 01100000 11000011 11111111"
	End Sub
	
	'''添加数字/字母字符
	Private Sub addDefAllText_()
		addDefNumText_()
		addDefEngText_()
	End Sub
	
	'''选择字符类型(字母/数字/全部)
	'p_t:指定类型
	Public Sub SelectTextType(Byval p_t)
		Select Case Cstr(p_t)
		Case "0" ,"all"
			addDefAllText_()
		Case "1", "num"
			addDefNumText_()
		Case "2", "eng"
			addDefEngText_()
		Case Else
			addDefAllText_()
		End Select
	End Sub
	
	'''删除已定义的字符
	Public Sub ClearTextData()
		Dim t_s : t_s = s_textDataLib(0)
		ReDim s_textDataLib(0)
		s_textDataLib(0) = t_s
	End Sub

	'''
	Private Function getBinary_(Byval p_i)
		Dim t_ib0,t_ib1,t_ib2,t_ibt0,t_ibt1,t_ibt2
		t_ib0 = Int(p_i / 16777216)
		t_ibt0= p_i Mod 16777216
		t_ib1 = Int(t_ibt0 / 65536)
		t_ibt1= t_ibt0 Mod 65536
		t_ib2 = Int(t_ibt1 / 256)
		t_ibt2= t_ibt1 Mod 256
		getBinary_ = ChrB(t_ibt2) & ChrB(t_ib2) & ChrB(t_ib1) & ChrB(t_ib0)
	End Function

	'''获取范围内的随机数
	'p_l:最小值
	'p_u:最大值
	Private Function getRnd_(Byval p_l, Byval p_u)
		Randomize(Timer())
		getRnd_ = Int((p_u - p_l + 1) * Rnd() + p_l)
	End Function
	
	'''从分割字符串中取出一个随机项
	'p_s:以“,”作为分隔符的字符串
	Private Function getColadRstring_(Byval p_s)
		Dim t_ca,t_al
		t_ca = Split(p_s,",")
		t_al = UBound(t_ca)
		getColadRstring_ = t_ca(getRnd_(0,t_al))
	End Function

	'''文件头
	Private Sub fileHeader_()
		Response.ExpiresAbsolute =Now() -1 
		Response.Expires =0 
		Response.CacheControl ="no-cache"
		Response.ContentType = "Image/BMP"
	End Sub

	'''图片文件头
	'p_s:大小
	'p_w:宽度
	'p_s:高度
	Private Sub setBmpHead_(Byval p_s, Byval p_w, Byval p_h)
		s_bmpHead = ChrB(66) & ChrB(77)
		s_bmpHead = s_bmpHead & getBinary_(p_s+54)
		s_bmpHead = s_bmpHead & getBinary_(0)
		s_bmpHead = s_bmpHead & getBinary_(54)
		s_bmpHead = s_bmpHead & getBinary_(40)
		s_bmpHead = s_bmpHead & getBinary_(p_w)
		s_bmpHead = s_bmpHead & getBinary_(p_h)
		s_bmpHead = s_bmpHead & ChrB(1) & ChrB(0)
		s_bmpHead = s_bmpHead & ChrB(24) & ChrB(0)
		s_bmpHead = s_bmpHead & getBinary_(0)
		s_bmpHead = s_bmpHead & getBinary_(p_s)
		s_bmpHead = s_bmpHead & getBinary_(65536)
		s_bmpHead = s_bmpHead & getBinary_(65536)
		s_bmpHead = s_bmpHead & getBinary_(16777216)
		s_bmpHead = s_bmpHead & getBinary_(16777216)
	End Sub

	'''从分割字符串中取出一个字符阵点信息
	'p_t:按格式的字符串
	Private Function GetTextData(Byval p_t)
		Dim t_ta, t_al, t_td
		t_ta = Split(s_textData(p_t)," ")
		t_al = UBound(t_ta)
		Dim t_tda(5)
		t_tda(0) = t_ta(0)
		t_tda(1) = t_ta(1)
		t_tda(2) = Len(t_ta(3))
		t_tda(3) = t_al - 2
		t_tda(4) = t_ta(2)
		For t_td = 3 To t_al Step +1
			t_tda(5) = t_tda(5) & " " & t_ta(t_td)
		Next
		GetTextData = t_tda
	End Function

	'''对字符串进行变形
	'p_c:要变形的字符串
	Private Function deformation_(Byval p_c)
		Dim t_nt, t_st, t_rt
		t_rt =Split(Mid(p_c, 3), " ")
		Randomize(Timer())
		Dim t_nd : t_nd =Int((5-1+1)*Rnd()+1)
		Dim t_rd
		Select Case t_nd
		Case 1 : t_rd =Array(0,0,0,0,0,0,0,0,0,0,0,0,0,0)
		Case 2 : t_rd =Array(0,0,0,1,1,1,2,2,2,3,3,3,4,4)
		Case 3 : t_rd =Array(4,4,4,3,3,3,2,2,2,1,1,1,0,0)
		Case 4 : t_rd =Array(2,1,1,0,0,0,0,0,0,0,0,1,1,2)
		Case 5 : t_rd =Array(0,1,1,1,2,2,2,2,2,2,1,1,1,0)
		End Select
		For t_nt =0 to ubound(t_rt)
			t_rt(t_nt) =Space(t_rd(t_nt)) & t_rt(t_nt)
			If Len(t_rt(t_nt)) <CharWidth Then
				t_rt(t_nt) =t_rt(t_nt) & Space(CharWidth -Len(t_rt(t_nt)))
			End If
			t_rt(t_nt) =Replace(t_rt(t_nt), " ", "0")
		Next
		Dim t_tp : t_tp =Int((( CharHeight - Ubound(Split(p_c, " ")) -1)-1+1)*Rnd()+1)
		For t_nt =1 To t_tp *CharWidth
			t_st =t_st &"0"
			If t_nt Mod CharWidth =0 Then
				t_st =t_st &" "
			End If
		Next
		For t_nt =0 To Ubound(t_rt)
			t_st =t_st & t_rt(t_nt) &" "
		Next
		Dim t_bp : t_bp =CharHeight - ( Ubound(t_rt) +1 ) - t_tp
		For t_nt =1 To t_bp *CharWidth
			t_st =t_st &"0"
			If t_nt Mod CharWidth =0 Then
				t_st =t_st &" "
			End If
		Next
		t_st =Trim(t_st)
		t_st =Left(p_c, 2) & t_st
		deformation_ =t_st
	End Function
	
	'''获取当前的随机数
	Private Function getRndTextData_()
		ReDim s_textData(TextLength-1)
		Dim t_t
		For t_t = 0 To TextLength-1 Step +1
			s_textData(t_t) = getColadRstring_(BackColor) & " " & getColadRstring_(TextColor) & " " & deformation_(s_textDataLib(getRnd_(1,s_textDataLength)))
			s_sessionString = s_sessionString & GetTextData(t_t)(4)
		Next
	End Function

	'''
	Private Function getColor_(Byval p_s)
		getColor_ = ChrB("&H" & Mid(p_s,6,2)) & ChrB("&H" & Mid(p_s,4,2)) & ChrB("&H" & Mid(p_s,2,2))
	End Function

	'''
	Private Function bmpColor_(Byval p_a, Byval p_b)
		Dim t_bc(1)
		t_bc(0) = getColor_(p_a)
		t_bc(1) = getColor_(p_b)
		bmpColor_ = t_bc
	End Function

	'''
	Private Sub setBmpData_()
		Dim TextInfo,FontData,I,J,K
		getRndTextData_()
		TextInfo = GetTextData(0)
		s_bmpHeight = TextInfo(3)
		s_bmpWidth = TextInfo(2) * TextLength   
		s_bmpSize = s_bmpHeight * s_bmpWidth * 3
		For I = s_bmpHeight To 1 Step -1
			For J = 0 To TextLength -1 Step +1
				TextInfo = GetTextData(J)
				FontData = Split(TextInfo(5)," ")(I)
				For K = 1 To TextInfo(2) Step +1
					If getRnd_(1,99) < YawpCount Then
						s_bmpData = s_bmpData & getColor_(getColadRstring_(YawpColor))
					Else
						s_bmpData = s_bmpData & bmpColor_(TextInfo(0),TextInfo(1))(Mid(FontData,K,1))
					End If
				Next
			Next
		Next
	End Sub

	'''输出验证码图片
	Public Sub Write()
		fileHeader_()
		setBmpData_()
		setBmpHead_ s_bmpSize,s_bmpWidth,s_bmpHeight
		Response.BinaryWrite s_bmpHead
		Response.BinaryWrite s_bmpData
		Session(SessionName) = s_sessionString
	End Sub
End Class
%>